Warning: package 'timeSeries' was built under R version 4.4.3
Loading required package: timeDate
Attaching package: 'timeSeries'
The following object is masked from 'package:dplyr':
lag
The following objects are masked from 'package:graphics':
lines, points
library(ggplot2)library(tsibble)
Warning: package 'tsibble' was built under R version 4.4.3
Registered S3 method overwritten by 'tsibble':
method from
as_tibble.grouped_df dplyr
Attaching package: 'tsibble'
The following object is masked from 'package:lubridate':
interval
The following objects are masked from 'package:base':
intersect, setdiff, union
library(lubridate)library(forecast)
Warning: package 'forecast' was built under R version 4.4.3
Registered S3 method overwritten by 'quantmod':
method from
as.zoo.data.frame zoo
Attaching package: 'forecast'
The following object is masked from 'package:yardstick':
accuracy
library(feasts)
Warning: package 'feasts' was built under R version 4.4.3
Loading required package: fabletools
Warning: package 'fabletools' was built under R version 4.4.3
Attaching package: 'fabletools'
The following object is masked from 'package:yardstick':
accuracy
The following object is masked from 'package:parsnip':
null_model
The following objects are masked from 'package:infer':
generate, hypothesize
library(zoo)
Warning: package 'zoo' was built under R version 4.4.3
Attaching package: 'zoo'
The following object is masked from 'package:tsibble':
index
The following object is masked from 'package:timeSeries':
time<-
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
library(xts)
Warning: package 'xts' was built under R version 4.4.3
######################### Warning from 'xts' package ##########################
# #
# The dplyr lag() function breaks how base R's lag() function is supposed to #
# work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
# source() into this session won't work correctly. #
# #
# Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
# conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
# dplyr from breaking base R's lag() function. #
# #
# Code in packages is not affected. It's protected by R's namespace mechanism #
# Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
# #
###############################################################################
Attaching package: 'xts'
The following objects are masked from 'package:dplyr':
first, last
library(fable)
Warning: package 'fable' was built under R version 4.4.3
library(prophet)
Warning: package 'prophet' was built under R version 4.4.3
Loading required package: Rcpp
Attaching package: 'Rcpp'
The following object is masked from 'package:rsample':
populate
Loading required package: rlang
Warning: package 'rlang' was built under R version 4.4.3
Attaching package: 'rlang'
The following objects are masked from 'package:purrr':
%@%, flatten, flatten_chr, flatten_dbl, flatten_int, flatten_lgl,
flatten_raw, invoke, splice
library(purrr)library(timetk)
Warning: package 'timetk' was built under R version 4.4.3
library(caret)
Warning: package 'caret' was built under R version 4.4.3
Loading required package: lattice
Attaching package: 'caret'
The following objects are masked from 'package:fabletools':
MAE, RMSE
The following objects are masked from 'package:yardstick':
precision, recall, sensitivity, specificity
The following object is masked from 'package:purrr':
lift
library(rsample)
Re-reading in data from Assignment 21:
library(dataRetrieval)
Warning: package 'dataRetrieval' was built under R version 4.4.3
# Example: Cache la Poudre River at Mouth (USGS site 06752260)poudre_flow <-readNWISdv(siteNumber ="06752260",parameterCd ="00060",startDate ="2013-01-01",endDate ="2023-12-31") |>renameNWISColumns() |>mutate(Date =yearmonth(Date)) |>mutate(Date =ym(Date)) |>group_by(Date) |>summarize(Flow =mean(Flow)) |>ungroup()
# Making the Tibble of Poudre Flow - Time Series Split:pf_tbl <-as_tibble(poudre_flow, index = Date)splits <-time_series_split(pf_tbl, assess ="12 months", cumulative =TRUE)
Using date_var: Date
training <-training(splits)testing <-testing(splits)
# A tibble: 204 × 7
.model_id .model_desc .key .index .value .conf_lo .conf_hi
<int> <chr> <fct> <date> <dbl> <dbl> <dbl>
1 NA ACTUAL actual 2013-01-01 18.1 NA NA
2 NA ACTUAL actual 2013-02-01 18.0 NA NA
3 NA ACTUAL actual 2013-03-01 8.21 NA NA
4 NA ACTUAL actual 2013-04-01 5.94 NA NA
5 NA ACTUAL actual 2013-05-01 333. NA NA
6 NA ACTUAL actual 2013-06-01 300. NA NA
7 NA ACTUAL actual 2013-07-01 75.6 NA NA
8 NA ACTUAL actual 2013-08-01 48.8 NA NA
9 NA ACTUAL actual 2013-09-01 1085. NA NA
10 NA ACTUAL actual 2013-10-01 146. NA NA
# ℹ 194 more rows
frequency = 12 observations per 1 year
frequency = 12 observations per 1 year
Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
frequency = 12 observations per 1 year
Merging Predicted and Actual:
I was having serious issues with trying to find .model_desc from my forecast, I ended up just providing what I have, in my graph below prophet does exist, but this is the code and data I was trying to provide with the subsequent error, although .model_desc WAS DEFNINITELY IN FUTURE FORECAST AND COMPARE DF! > compare_df <- future_forecast |> + filter(.model_desc %in% c(“UPDATE: ARIMA(0,0,2)(0,1,1)[12]”, “PROPHET”)) |> + select(Date = .index, .model_desc, .value) |> + left_join(pf_future, by = “Date”) |> + rename(Predicted = .value, Observed = Flow) Error: object ‘.model_desc’ not found
lm_model <-lm(Observed ~ Predicted, data = compare_df)summary(lm_model)$r.squared
[1] 0.6932388
R-squared value = 0.693…
This is a very good R-squared value, indicating that the predicted values are closr to the actual values, however, there is still some uncertainty that we can see with the data that was predicted, since the value isn’t at 1.
Plotting the Predicted and Observed
ggplot(compare_df, aes(x = Predicted, y = Observed)) +geom_point(aes(color = .model_desc)) +geom_abline(slope =1, intercept =0, linetype ="dashed", color ="gray40") +geom_smooth(method ="lm", se =FALSE, color ="black") +facet_wrap(~ .model_desc) +labs(title ="Predicted vs Observed Streamflow",x ="Predicted Monthly Flow (cfs)",y ="Observed Monthly Flow (cfs)",subtitle ="ESS330 A-22 | Neva Morgan") +theme_minimal()
